home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacTech 1 to 12
/
MacTech-vol-1-12.toast
/
Tools
/
Alpha 6.51b13 ƒ
/
Tcl
/
Modes
/
htmlElems.tcl
< prev
next >
Wrap
Text File
|
1997-01-21
|
31KB
|
1,126 lines
#===============================================================================
#
# htmlElems.tcl (called by html.tcl)
#
# Part of HTML mode 1.4
#
# Macros for HTML elements.
#
# Copyright 1996, 1997 by Johan Linde <jl@theophys.kth.se>.
# This software may be used freely, and distributed freely, as long as
# the receiver is not obligated in any way by receiving it.
#
# If you make improvements to this file, please share them!
#
#===============================================================================
#
# <P>
#
proc htmlElemParagraph {{attr ""}} {
global HTMLmodeVars
if {$HTMLmodeVars(pIsContainer)} {
htmlBuildCR2Elem P $attr
} else {
htmlBuildOpening P 1 1 $attr
}
}
# Insert a <BR> in the end of every line in selection.
proc htmlInsertLineBreaks {} {
if {![isSelection]} {
beep
message "No selection."
return
}
foreach ln [split [string trimright [getSelect] "\r"] "\r"] {
append text "${ln}[htmlSetCase <BR>]\r"
}
replaceText [getPos] [selEnd] $text
}
# Remove all <BR> in selection.
proc htmlRemoveLineBreaks {} {
if {![isSelection]} {
beep
message "No selection."
return
}
regsub -all "<(b|B)(r|R)(\[ \t\r\]+\[^>\]*>|>)" [getSelect] "" text
if {$text != [getSelect]} {
replaceText [getPos] [selEnd] $text
}
}
# Insert <P> at empty lines in selection, and in the beginning of the selection.
# Several empty lines are contracted to one.
proc htmlInsertParagraphs {} {
global HTMLmodeVars
if {![isSelection]} {
beep
message "No selection."
return
}
set pIsContainer $HTMLmodeVars(pIsContainer)
if {[set oelem [htmlOpenElem P "" 0]] == ""} {return}
set text "\r$oelem\r"
set prevLineEmpty 1
foreach ln [split [string trim [getSelect] "\r"] "\r"] {
regexp {[ \t]*} $ln lntest
# Only add <P> if previous line was not empty.
if {$ln == $lntest && !$prevLineEmpty} {
set prevLineEmpty 1
if {$pIsContainer} {
append text "[htmlCloseElem P]\r\r$oelem\r"
} else {
append text "\r$oelem\r"
}
} else {
# Skip an empty line which follows another empty line.
if {$ln != $lntest} {
set prevLineEmpty 0
append text "$ln\r"
}
}
}
if {$pIsContainer} {
append text "[htmlCloseElem P]\r\r"
}
replaceText [getPos] [selEnd] $text
}
# Ask for input how to build a list. Returns "number of items" and
# "ask for list item attributes". Returns "" if canceled or any problem.
proc htmlListQuestions {ltype liattr lipr} {
global HTMLmodeVars
set promptNoisily $HTMLmodeVars(promptNoisily)
if {[string length $liattr]} {
set optatts [htmlGetOptional $liattr]
set usedatts [htmlGetUsed $liattr]
set askForMore [htmlGetAttrMore $liattr]
} else {
set optatts ""
set askForMore [htmlGetAttrMore LI]
set usedatts [htmlGetUsed LI]
}
if {$lipr != "LI"} {
set optatts [concat $optatts [htmlGetOptional DD]]
set usedatts [concat $usedatts [htmlGetUsed DD]]
if {!$askForMore} {set askForMore [htmlGetAttrMore DD]}
}
if {$HTMLmodeVars(useBigWindows)} {
set it {0 0 3 0}
while {1} {
set txt "dialog -w 280 -h 130 -b OK 20 100 75 120 -b Cancel 110 100 165 120 \
-t {$ltype list} 100 10 250 30 \
-t {How many items?} 10 40 150 60 -e [list [lindex $it 2]] 160 40 180 55"
if {[llength $optatts]} {
append txt " -c {Ask for attributes for each $lipr} [lindex $it 3] \
10 70 330 85"
}
set it [eval $txt]
if {[lindex $it 1]} {return}
set items [lindex $it 2]
if {[llength $it] == 4 && [lindex $it 3]} {
set askForLiAttr 1
} else {
set askForLiAttr 0
}
if {![htmlIsUnsignedInteger $items] && $ltype != "DL"} {
alertnote "Invalid input: non-negative integer required"
} elseif {![htmlIsPositiveInteger $items] && $ltype == "DL"} {
alertnote "Invalid input: positive integer required"
} else {
break
}
}
} else {
if {$promptNoisily} {beep}
while {[catch {statusPrompt "$ltype list: How many items? " htmlNumberStatusFunc} items]} {
if {$items == "Cancel all!"} {message "Cancel"; return}
}
if {![htmlIsUnsignedInteger $items] && $ltype != "DL"} {
beep; message "Invalid input: non-negative integer required."; return
} elseif {![htmlIsPositiveInteger $items] && $ltype == "DL"} {
beep; message "Invalid input: positive integer required."; return
}
if {(([llength $optatts] && $askForMore) || [llength $usedatts]) && $items} {
if {$promptNoisily} {beep}
while {[catch {statusPrompt "Ask for attributes for each $lipr? \[n\] " \
htmlStatusAskYesOrNo} v]} {
if {$v == "Cancel all!"} {message "Cancel"; return}
}
if {$v == "yes"} {
set askForLiAttr 1
} else {
set askForLiAttr 0
}
} else {
set askForLiAttr 0
}
}
return [list $items $askForLiAttr]
}
# Lists: Puts <cr>s before and after a list, inserts <li>, leaves the
# insertion point there. If anything is selected, makes it the first item.
proc htmlBuildList {ltype {liattr ""} {listattr ""}} {
global HTMLmodeVars
global htmlCurSel
global htmlIsSel
set useTabMarks $HTMLmodeVars(useTabMarks)
set containers $HTMLmodeVars(lidtAreContainers)
set listStr [htmlListQuestions $ltype $liattr LI]
if {![llength $listStr]} {
return
} else {
set items [lindex $listStr 0]
set askForLiAttr [lindex $listStr 1]
}
# If zero list items, just make an htmlBuildCR2Elem
if {$items == 0} {
htmlBuildCR2Elem $ltype $listattr
return
}
htmlGetSel
set sel $htmlCurSel
set IsSel $htmlIsSel
set text [htmlOpenCR 1]
if {$containers} {
if {[set text1 "[htmlOpenElem $ltype $listattr 0]\r"] == "\r"} {return}
append text $text1
if {$askForLiAttr} {
set text1 [htmlOpenElem LI $liattr 0]
} else {
set text1 [htmlOpenElem LI NOATTR 0]
}
if {$text1 == ""} {return}
append text $text1
if {$IsSel} {
append text "${sel}[htmlCloseElem LI]"
set currpos [expr [getPos] + [string length $text]]
} else {
set currpos [expr [getPos] + [string length $text]]
append text [htmlCloseElem LI]
}
for {set i 1} {$i < $items} {incr i} {
append text "\r"
if {$askForLiAttr} {
set text1 [htmlOpenElem LI $liattr 0]
} else {
set text1 [htmlOpenElem LI NOATTR 0]
}
if {$text1 == ""} {return}
append text $text1
if {$i == 1 && $IsSel} {
set currpos [expr [getPos] + [string length $text]]
} elseif {$useTabMarks} {
append text "•"
}
append text [htmlCloseElem LI]
}
} else {
if {[set text1 [htmlOpenElem $ltype $listattr 0]] == ""} {return}
append text $text1
append text "\r"
if {$askForLiAttr} {
set text1 [htmlOpenElem LI $liattr 0]
} else {
set text1 [htmlOpenElem LI NOATTR 0]
}
if {$text1 == ""} {return}
append text $text1
if {$IsSel} {
append text $sel
}
set currpos [expr [getPos] + [string length $text]]
for {set i 1} {$i < $items} {incr i} {
append text "\r"
if {$askForLiAttr} {
set text1 [htmlOpenElem LI $liattr 0]
} else {
set text1 [htmlOpenElem LI NOATTR 0]
}
if {$text1 == ""} {return}
append text $text1
if {$useTabMarks} {append text "•"}
}
}
append text "\r[htmlCloseElem $ltype]\r\r"
if {$useTabMarks} {append text "•"}
if {$IsSel} { deleteSelection }
insertText $text
goto $currpos
}
# Add list entry. If there is a selection, make it the entry.
proc htmlElemListEntry {liattr} {
global htmlCurSel htmlIsSel HTMLmodeVars
set containers $HTMLmodeVars(lidtAreContainers)
set useTabMarks $HTMLmodeVars(useTabMarks)
htmlGetSel
set sel $htmlCurSel
set isSel $htmlIsSel
set text [htmlOpenCR]
if {[set text1 [htmlOpenElem LI $liattr 0]] == ""} {return}
append text $text1
if {$isSel} { deleteSelection }
if {$containers} {
if {$isSel} {
insertText $text "${sel}" [htmlCloseElem LI]
} else {
set currpos [expr [getPos] + [string length $text]]
append text [htmlCloseElem LI]
if {$useTabMarks} { append text "•"}
insertText $text
goto $currpos
}
} else {
insertText $text $sel
}
}
# Make list items from selction.
proc htmlMakeList {} {
global HTMLmodeVars
set isContainer $HTMLmodeVars(lidtAreContainers)
if {![isSelection]} {
beep
message "No selection."
return
}
set values [dialog -w 220 -h 130 -t "Make list" 50 10 210 30 \
-t "Each item begins with:" 10 40 160 55 -e "*" 170 40 200 55 \
-t "List:" 10 65 50 85 -m {UL UL OL DIR MENU None} 55 65 200 85 \
-b OK 20 100 85 120 -b Cancel 105 100 170 120]
if {[lindex $values 3]} {return}
set itemStr [string trim [lindex $values 0]]
set listtype [lindex $values 1]
if {![string length $itemStr]} {
beep
message "You must give a string which each item begins with."
return
}
set startPos [getPos]
set endPos [selEnd]
if {[catch {search -s -f 1 -i 0 -r 0 -m 0 $itemStr $startPos} res] || \
[lindex $res 1] > $endPos} {
beep
message "No list item in selection."
return
}
# Check that the selections begins with a list item.
set preText [getText $startPos [lindex $res 0]]
if {![htmlIsWhite $preText]} {
beep
message "There is some text before the first list item."
return
}
if {$listtype != "None"} {
set text "[htmlOpenCR 1]<[htmlSetCase $listtype]>\r"
} else {
set text [htmlOpenCR]
}
# Get each list item.
set startPos [lindex $res 1]
while {![catch {search -s -f 1 -i 0 -r 0 -m 0 $itemStr $startPos} res2] && \
[lindex $res2 1] <= $endPos} {
set text2 [string trimleft [string trimright [getText $startPos [lindex $res2 0]] "\r"]]
append text "<[htmlSetCase LI]>$text2"
if {$isContainer} {append text [htmlCloseElem LI]}
append text "\r"
set startPos [lindex $res2 1]
}
set text2 [string trimleft [string trimright [getText $startPos $endPos] "\r"]]
append text "<[htmlSetCase LI]>$text2"
if {$isContainer} {append text [htmlCloseElem LI]}
append text "\r"
if {$listtype != "None"} {append text [htmlCloseElem $listtype] "\r\r"}
replaceText [getPos] [selEnd] $text
}
# Discursive Lists (term and description elems)
#
# The selection becomes the *description* (*not* the term)
# Build a discursive list
proc htmlBuildDiscList {} {
global htmlCurSel
global htmlIsSel
global HTMLmodeVars
set containers $HTMLmodeVars(lidtAreContainers)
set useTabMarks $HTMLmodeVars(useTabMarks)
set listStr [htmlListQuestions DL DT "DT and DD"]
if {![llength $listStr]} {
return
} else {
set dlEntries [lindex $listStr 0]
set askForLiAttr [lindex $listStr 1]
}
if {$askForLiAttr} {
set liattr ""
} else {
set liattr NOATTR
}
htmlGetSel
set Sel $htmlCurSel
set text [htmlOpenCR 1]
if {$containers} {
if {[set text1 "[htmlOpenElem DL "" 0]\r"] == "\r"} {return}
append text $text1
# the first entry
if {[set text1 [htmlOpenElem DT $liattr 0]] == ""} {return}
append text $text1
set currpos [expr [getPos] + [string length $text]]
append text "[htmlCloseElem DT]\t"
if {[set text1 [htmlOpenElem DD $liattr 0]] == ""} {return}
append text $text1
if {$htmlIsSel} {
append text $Sel
} elseif {$useTabMarks} {
append text "•"
}
append text [htmlCloseElem DD]
# the rest of the entries
for {set i 1} {$i < $dlEntries} {incr i} {
append text "\r"
if {[set text1 [htmlOpenElem DT $liattr 0]] == ""} {return}
append text $text1
if {$useTabMarks} { append text "•" }
append text [htmlCloseElem DT]
append text "\t"
if {[set text1 [htmlOpenElem DD $liattr 0]] == ""} {return}
append text $text1
if {$useTabMarks} { append text "•" }
append text [htmlCloseElem DD]
}
if {$useTabMarks} {append text "•"}
} else {
if {[set text1 [htmlOpenElem DL "" 0]] == ""} {return}
append text $text1
append text "\r"
# The first entry
if {[set text1 [htmlOpenElem DT $liattr 0]] == ""} {return}
append text $text1
set currpos [expr [getPos] + [string length $text]]
append text "\t"
if {[set text1 [htmlOpenElem DD $liattr 0]] == ""} {return}
append text $text1
if {$htmlIsSel} {
append text $Sel
}
if {$useTabMarks} {append text "•"}
# Now for the rest of the entries
for {set i 1} {$i < $dlEntries} {incr i} {
append text "\r"
if {[set text1 [htmlOpenElem DT $liattr 0]] == ""} {return}
append text $text1
if {$useTabMarks} {append text "•"}
append text "\t"
if {[set text1 [htmlOpenElem DD $liattr 0]] == ""} {return}
append text $text1
if {$useTabMarks} {append text "•"}
}
}
append text "\r[htmlCloseElem DL]\r\r"
if {$useTabMarks} {append text "•"}
if {$htmlIsSel} { deleteSelection }
insertText $text
goto $currpos
}
# Add an individual entry to a discursive list
proc htmlElemDiscEntry {} {
global htmlCurSel htmlIsSel
global HTMLmodeVars
set useTabMarks $HTMLmodeVars(useTabMarks)
set containers $HTMLmodeVars(lidtAreContainers)
htmlGetSel
set Sel $htmlCurSel
set text [htmlOpenCR]
if {$containers} {
if {[set text1 [htmlOpenElem DT "" 0]] == ""} {return}
append text $text1
set currpos [expr [getPos] + [string length $text]]
append text "[htmlCloseElem DT]\t"
if {[set text1 [htmlOpenElem DD "" 0]] == ""} {return}
append text $text1
if {$htmlIsSel} {
append text ${Sel}
} elseif {$useTabMarks} {append text "•"}
append text [htmlCloseElem DD]
if {$useTabMarks} {append text "•"}
if {$htmlIsSel} { deleteSelection }
insertText $text [htmlCloseCR]
} else {
if {[set text1 [htmlOpenElem DT "" 0]] == ""} {return}
append text $text1
set currpos [expr [getPos] + [string length $text]]
append text "\t"
if {[set text1 [htmlOpenElem DD "" 0]] == ""} {return}
append text $text1
if {$htmlIsSel} {
append text $Sel
}
if {$useTabMarks} {append text "•"}
if {$htmlIsSel} { deleteSelection }
insertText $text [htmlCloseCR]
}
goto $currpos
}
# Different Input fields
proc htmlBuildInputElem {inputelem {cr1 0} {cr2 1}} {
htmlBuildOpening "INPUT TYPE=\"${inputelem}\"" $cr1 $cr2 $inputelem
}
# Table template. If there is any selection it is put in the first cell.
proc htmlTableTemplate {} {
global htmlCurSel htmlIsSel HTMLmodeVars
set useTabMarks $HTMLmodeVars(useTabMarks)
set values {"" "" 0 0 0}
set rows ""
set cols ""
set tableOpen "<[htmlSetCase TABLE]>"
set trOpen "<[htmlSetCase TR]>"
while {1} {
set box "-t {Table template} 50 10 200 25 \
-p 50 26 150 27 \
-t {Number of rows} 10 40 150 55 -e [list [lindex $values 0]] 160 40 180 55 \
-t {Number of columns} 10 65 150 80 -e [list [lindex $values 1]] 160 65 180 80 \
-c {Table headers in first row} [lindex $values 2] 10 90 250 112 \
-c {Table headers in first column} [lindex $values 3] 10 112 250 134 \
-c {Don't insert TABLE tags} [lindex $values 4] 10 134 250 156 \
-b OK 20 250 85 270 -b Cancel 105 250 170 270\
-b {TABLE attributes} 10 170 150 190 -b {TR attributes} 10 200 150 220 "
set values [eval [concat dialog -w 230 -h 280 $box]]
# Cancel?
if {[lindex $values 6] } {return}
set rows [lindex $values 0]
set cols [lindex $values 1]
set THrow [lindex $values 2]
set THcol [lindex $values 3]
set table [expr ![lindex $values 4]]
if {[lindex $values 7]} {
if {!$table} {
alertnote "You have chosen not to insert TABLE tags."
} elseif {[set tmp [htmlChangeElement [string range $tableOpen 1 [expr [string length $tableOpen] - 2]] TABLE]] != ""} {
set tableOpen $tmp
}
continue
}
if {[lindex $values 8]} {
if {[set tmp [htmlChangeElement [string range $trOpen 1 [expr [string length $trOpen] - 2]] TR]] != ""} {
set trOpen $tmp
}
continue
}
if {![htmlIsPositiveInteger $rows] || ![htmlIsPositiveInteger $cols] } {
alertnote "The number of rows and columns must be specified."
} else {
break
}
}
htmlGetSel
if {$htmlIsSel} {deleteSelection}
set text [htmlOpenCR 1]
if {$table} {append text "\r" $tableOpen "\r"}
for {set i 1} {$i <= $rows} {incr i} {
if {$i > 1 || $table} {append text "\r"}
append text "$trOpen\r"
for {set j 1} {$j <= $cols} {incr j} {
# Put TH in first row or column?
if {$i == 1 && $THrow || $j == 1 && $THcol} {
set cell [htmlSetCase TH]
} else {
set cell [htmlSetCase TD]
}
append text "<$cell>"
if {$i == 1 && $j == 1} {
if {$htmlIsSel} {
append text $htmlCurSel
} else {
set curPos [expr [getPos] + [string length $text]]
}
} elseif {$htmlIsSel && ( $i == 1 && $j == 2 || $i == 2 && $cols == 1 )} {
set curPos [expr [getPos] + [string length $text]]
} elseif {$useTabMarks} {
append text "•"
}
append text [htmlCloseElem $cell]
}
append text "\r[htmlCloseElem TR]\r"
}
if {$table} {append text "\r[htmlCloseElem TABLE]\r\r"}
if {$useTabMarks && ($rows > 1 || $cols > 1 || !$htmlIsSel)} {append text "•"}
insertText $text
goto $curPos
}
# Take table rows in a selection and remove the TR, TD and TH elements and
# put tabs between the elements.
proc htmlrowsToTabs {} {
if {![isSelection]} {
beep
message "No selection."
return
}
set startPos [getPos]
set endPos [selEnd]
if {[catch {search -s -f 1 -i 1 -r 1 -m 0 {<TR([ \t\r]+[^>]*>|>)} $startPos} res] || \
[lindex $res 1] > $endPos} {
beep
message "No table row in selection."
return
}
# Check that the selections begins with a table row.
set preText [getText $startPos [lindex $res 0]]
if {![htmlIsWhite $preText]} {
beep
message "First part of selection is not in a table row."
return
}
# Extract each table row.
set startPos [lindex $res 1]
while {![catch {search -s -f 1 -i 1 -r 1 -m 0 {<TR([ \t\r]+[^>]*>|>)} $startPos} res2] && \
[lindex $res2 1] <= $endPos} {
set text2 [getText $startPos [lindex $res2 0]]
regsub -all "\[\t\r\]+" $text2 " " text2
append text [string trim $text2] "\r"
set startPos [lindex $res2 1]
}
set text2 [getText $startPos $endPos]
regsub -all "\[\t\r\]+" $text2 " " text2
append text [string trim $text2]
# Check that there is nothing after the last table row.
if {![catch {search -s -f 1 -i 1 -r 1 -m 0 {</TR>} $startPos} res] \
&& [lindex $res 1] <= $endPos} {
set preText [getText [lindex $res 1] $endPos]
if {![htmlIsWhite $preText]} {
beep
message "Last part of selection not in a table row."
return
}
}
# Make the transformation.
foreach ln [split $text "\r"] {
if {![string length $ln]} continue
regsub -all {> +<} $ln "><" ln
regsub -all {<(t|T)(h|H|d|D)([ ]+[^>]*>|>)} $ln "\t" ln
regsub { } $ln "" ln
regsub -all {</(t|T)(h|H|d|D|r|R)>} $ln "" ln
append out "$ln\r"
}
replaceText [getPos] [selEnd] $out
}
# Convert tab-delimited format to table rows.
# First row and first coloumn can optionally consist of table headers.
proc htmltabsToRows {where} {
global HTMLmodeVars
if {$where == "selection"} {
if {![isSelection]} {
beep
message "No selection."
return
}
set tabtext [string trim [getSelect]]
set newln "\r"
set htext "Tabs to Rows"
} else {
set fil [getfile "Select file with table."]
if {![htmlIsTextFile $fil alertnote]} {return}
set fid [open $fil r]
set tabtext [string trim [read $fid]]
close $fid
if {[regexp {\n} $tabtext]} {
set newln "\n"
} else {
set newln "\r"
}
regsub -all "\n\r" $tabtext "\n" tabtext
set htext "Import table"
}
set values {0 0 0}
set tableOpen "<[htmlSetCase TABLE]>"
set trOpen "<[htmlSetCase TR]>"
while {1} {
set box "-t [list $htext] 50 10 200 25 \
-p 50 26 150 27 \
-c {Table headers in first row} [lindex $values 0] 10 40 250 62 \
-c {Table headers in first column} [lindex $values 1] 10 62 250 84 \
-c {Don't insert TABLE tags} [lindex $values 2] 10 84 250 106 \
-b OK 20 200 85 220 -b Cancel 105 200 170 220\
-b {TABLE attributes} 10 120 150 140 -b {TR attributes} 10 150 150 170 "
set values [eval [concat dialog -w 230 -h 230 $box]]
# Cancel?
if {[lindex $values 4] } {return}
set THrow [lindex $values 0]
set THcol [lindex $values 1]
set table [expr ![lindex $values 2]]
if {[lindex $values 5]} {
if {!$table} {
alertnote "You have chosen not to insert TABLE tags."
} elseif {[set tmp [htmlChangeElement [string range $tableOpen 1 [expr [string length $tableOpen] - 2]] TABLE]] != ""} {
set tableOpen $tmp
}
continue
}
if {[lindex $values 6]} {
if {[set tmp [htmlChangeElement [string range $trOpen 1 [expr [string length $trOpen] - 2]] TR]] != ""} {
set trOpen $tmp
}
continue
}
break
}
set oelem "${trOpen}\r"
if {$oelem == "\r"} {return}
set out [htmlOpenCR 1]
if {$table} {append out "\r" $tableOpen "\r"}
set i 1
foreach ln [split $tabtext $newln] {
if {![string length $ln]} {
append out "$oelem[htmlCloseElem TR]\r"
} else {
# Should there be headers in the first row?
if {$i == 1 && $THrow} {
set cell TH
} else {
set cell TD
}
# Should there be headers in the first column?
if {$THcol || ($i == 1 && $THrow)} {
set fcell TH
} else {
set fcell TD
}
regsub -all { } $ln [htmlSetCase "</$cell><$cell>"] ln
if {$THcol} {
regsub {[tT][dDhH]} $ln [htmlSetCase TH] ln
}
if {$i > 1 || $table} {append out "\r"}
append out "$oelem<[htmlSetCase $fcell]>$ln"
# Add cell or fcell closing, depending on if there is more than one cell.
if {![regexp [htmlCloseElem $fcell] $ln]} {
append out [htmlCloseElem $fcell]
} else {
append out [htmlCloseElem $cell]
}
append out "\r[htmlCloseElem TR]\r"
}
incr i
}
if {$table} {append out "\r[htmlCloseElem TABLE]\r\r"}
if {$where == "selection"} {
replaceText [getPos] [selEnd] $out
} else {
insertText $out
}
}
# Converts an NCSA or CERN image map file to a client side image map.
proc htmlConvertMap {type} {
if {[catch {getfile "Select the $type image map file."} fil] || ![htmlIsTextFile $fil alertnote] ||
[catch {open $fil r} fid]} {return}
set filecont [read $fid]
close $fid
if {[regexp {\n} $filecont]} {
set newln "\n"
} else {
set newln "\r"
}
set area [html${type}map [split $filecont $newln]]
set text [lindex $area 2]
if {![string length $text]} {
alertnote "No image map found in [file tail $fil]."
return
} elseif {[lindex $area 1]} {
if {[askyesno "Some lines in [file tail $fil] have invalid syntax. They are ignored. Continue?"] == "no"} {return}
} elseif {[lindex $area 0]} {
if {[askyesno "Some lines in [file tail $fil] specify a shape not supported. They are ignored. Continue?"] == "no"} {return}
}
if {![string length [set map [htmlOpenElem MAP "" 0]]]} {return}
insertText [htmlOpenCR 1] $map "\r" $text [htmlCloseElem MAP] "\r\r"
}
proc htmlNCSAmap {lines} {
set notknown 0
set someinvalid 0
set area ""
set defarea ""
foreach l $lines {
set invalid 0
set l [string trim $l]
# Skip comments and blank lines
if {[regexp {^#} $l] || ![string length $l]} {continue}
set shape [string toupper [lindex $l 0]]
if {[lsearch {RECT CIRCLE POLY DEFAULT} $shape] < 0} {
set notknown 1
continue
}
set url [lindex $l 1]
set exp "^\[0-9\]+,\[0-9\]+$"
if {[regexp $exp $url]} {
set url ""
set cind 1
} else {
set cind 2
}
switch $shape {
RECT {
if {[regexp $exp [lindex $l $cind]] && [regexp $exp [lindex $l [expr $cind + 1]]]} {
set coord "[lindex $l $cind],[lindex $l [expr $cind + 1]]"
} else {
set invalid 1
}
}
CIRCLE {
if {[regexp $exp [lindex $l $cind] cent] && [regexp $exp [lindex $l [expr $cind + 1]] edge]} {
regexp {[0-9]+} $cent xc
regexp {[0-9]+} $edge xe
set coord "$cent,[expr $xe-$xc]"
} else {
set invalid 1
}
}
POLY {
set coord ""
foreach c [lrange $l $cind end] {
if {![regexp $exp $c]} {
set invalid 1
break
}
append coord "$c,"
}
set coord [string trimright $coord ,]
}
}
if {!$invalid} {
if {$shape == "DEFAULT"} {
set toapp defarea
} else {
set toapp area
}
append $toapp "<" [htmlSetCase "AREA SHAPE=\"$shape\""]
if {$shape != "DEFAULT"} {
append $toapp " [htmlSetCase COORDS]=\"$coord\""
}
if {[string length $url]} {
append $toapp " [htmlSetCase HREF]=\"$url\""
} else {
append $toapp " [htmlSetCase NOHREF]"
}
append $toapp ">\r"
} else {
set someinvalid 1
}
}
append area $defarea
return [list $notknown $someinvalid $area]
}
proc htmlCERNmap {lines} {
set notknown 0
set someinvalid 0
set area ""
set defarea ""
foreach l $lines {
set invalid 0
set l [string trim $l]
# Skip comments and blank lines
if {[regexp {^#} $l] || ![string length $l]} {continue}
set shape [string toupper [lindex $l 0]]
if {![string match RECT* $shape] && ![string match CIRC* $shape] &&
![string match POLY* $shape] && ![string match DEFAULT $shape]} {
set notknown 1
continue
}
set exp "^\\(\[0-9\]+,\[0-9\]+\\)$"
switch -glob $shape {
RECT* {
set url [lindex $l 3]
if {[regexp $exp [lindex $l 1]] && [regexp $exp [lindex $l 2]]} {
set coord "[string trimleft [string trimright [lindex $l 1] )] (],[string trimleft [string trimright [lindex $l 2] )] (]"
set shape RECT
} else {
set invalid 1
}
}
CIRC* {
set url [lindex $l 3]
if {[regexp $exp [lindex $l 1]] && [regexp {^[0-9]+$} [lindex $l 2]]} {
set coord "[string trimleft [string trimright [lindex $l 1] )] (],[lindex $l 2]"
set shape CIRCLE
} else {
set invalid 1
}
}
POLY* {
set coord ""
set url [lindex $l [expr [llength $l] - 1]]
if {[regexp $exp $url]} {
set url ""
set cind 1
} else {
set cind 2
}
foreach c [lrange $l 1 [expr [llength $l] - $cind]] {
if {![regexp $exp $c]} {
set invalid 1
break
}
append coord "[string trimleft [string trimright $c )] (],"
}
set coord [string trimright $coord ,]
set shape POLY
}
DEFAULT {
set url [lindex $l 1]
}
}
if {!$invalid} {
if {$shape == "DEFAULT"} {
set toapp defarea
} else {
set toapp area
}
append $toapp "<" [htmlSetCase "AREA SHAPE=\"$shape\""]
if {$shape != "DEFAULT"} {
append $toapp " [htmlSetCase COORDS]=\"$coord\""
}
if {[string length $url]} {
append $toapp " [htmlSetCase HREF]=\"$url\""
} else {
append $toapp " [htmlSetCase NOHREF]"
}
append $toapp ">\r"
} else {
set someinvalid 1
}
}
append area $defarea
return [list $notknown $someinvalid $area]
}
proc htmlElemComment {} {
global htmlCurSel
global htmlIsSel
global HTMLmodeVars
set comStrs [htmlCommentStrings]
htmlGetSel
if {$htmlIsSel} { deleteSelection }
set text "[htmlOpenCR][lindex $comStrs 0]$htmlCurSel"
set currpos [expr [getPos] + [string length $text]]
append text [lindex $comStrs 1] [htmlCloseCR]
if {!$htmlIsSel && $HTMLmodeVars(useTabMarks)} {append text "•"}
insertText $text
if {!$htmlIsSel} {
goto $currpos
}
}
#
# Template for new file: HTML, TITLE, HEAD, BODY or FRAMESET
# Optionally input BASE, LINK, ISINDEX, META and SCRIPT in HEAD.
# We do not put in a DOCTYPE line.
proc htmlNewTemplate {doctype} {
global htmlCurSel htmlIsSel HTMLmodeVars htmlHeadElements1 htmlHeadElements3 htmlPackageToUse
set useTabMarks $HTMLmodeVars(useTabMarks)
set footers $HTMLmodeVars(footers)
set headelems [set htmlHeadElements$htmlPackageToUse]
set bodyText ""
# If the window is not empty, either delete text or put it in the body.
if {![htmlIsEmptyFile]} {
set delBox [dialog -w 320 -h 90 -t "Nonempty window. Do you want to put the text\
in the document's BODY, or delete it?" 10 10 310 50 \
-b "Put in BODY" 20 60 120 80 -b Delete 140 60 205 80 -b Cancel 225 60 290 80]
if {[lindex $delBox 1]} {
deleteText 0 [maxPos]
} elseif {[lindex $delBox 2]} {
return
} else {
set bodyText "[getText 0 [maxPos]]\r"
}
}
if {$doctype == "FRAMESET"} {
set htxt "New document with frames"
} else {
set htxt "New document"
}
# Building footer menu.
foreach f $footers {
lappend foot [file tail $f]
}
set footmenu {"No footer"}
if {[info exists foot]} {
set footmenu [concat $footmenu [lsort $foot]]
}
set docTitle ""
set inHead {0 0 ""}
foreach elem $headelems {
lappend inHead 0
}
lappend inHead "No footer"
while {![string length $docTitle]} {
# Construct the dialog box.
set box "-t [list $htxt] 100 10 300 25 -p 100 30 250 31 -t {TITLE} 10 40 60 55 \
-e [list [lindex $inHead 2]] 70 40 390 55 \
-t {Select the elements you want in the document\'s HEAD} 10 70 390 85"
set hpos 100
set wpos 10
set i 3
foreach elem $headelems {
append box " -c $elem [lindex $inHead $i] $wpos $hpos [expr $wpos + 100] [expr $hpos + 15]"
incr wpos 100
if {$wpos > 110} {set wpos 10; incr hpos 20}
incr i
}
if {$wpos > 10} {incr hpos 20}
incr hpos 10
append box " -t Footer 10 $hpos 80 [expr $hpos + 15] \
-m [list [concat [list [lindex $inHead $i]] $footmenu]] 90 $hpos 250 [expr $hpos + 15]"
incr hpos 30
set inHead [eval [concat dialog -w 400 -h [expr $hpos + 30] \
-b OK 20 $hpos 85 [expr $hpos + 20] \
-b Cancel 110 $hpos 175 [expr $hpos + 20] $box]]
if {[lindex $inHead 1] } {
if {[lindex $delBox 1]} {undo}
return
}
set docTitle [string trim [lindex $inHead 2]]
if {![string length $docTitle]} {
alertnote "A document title is required."
}
}
if {[set text [htmlOpenElem HTML "" 0]] == "" ||
[set text1 [htmlOpenElem HEAD "" 0]] == "" ||
[set text2 [htmlOpenElem TITLE "" 0]] == ""} {
if {[lindex $delBox 1]} {undo}
return
}
append text "\r\r${text1}\r\r"
append text "${text2}${docTitle}[htmlCloseElem TITLE]\r"
set hasScript 0
for {set i 0} {$i < [llength $headelems]} {incr i} {
if {[lindex $inHead [expr $i + 3]]} {
if {[set text1 [htmlOpenElem [lindex $headelems $i] "" 0]] != ""} {
append text "\r${text1}"
if {[lindex $headelems $i] == "SCRIPT"} {
append text "\r<!-- Hide content from old browsers\r"
set currpos [string length $text]
set hasScript 1
append text "\r// end hiding content from old browsers -->\r[htmlCloseElem SCRIPT]"
}
}
}
}
append text "\r\r[htmlCloseElem HEAD]\r\r"
if {[set text1 [htmlOpenElem $doctype "" 0]] == ""} {
if {[lindex $delBox 1]} {undo}
return
}
append text "$text1\r\r"
append text $bodyText
if {!$hasScript} {
set currpos [string length $text]
} elseif {$useTabMarks} {
append text "•"
}
# Insert footer.
set footval [lindex $inHead [expr [llength $headelems] + 3]]
if {$footval != "No footer"} {
set footerFile [lindex $footers [lsearch -exact $foot $footval]]
if {![catch {readFile $footerFile} footText]} {
append text "\r\r$footText"
} else {
alertnote "Could not read footer, $footerFile"
}
}
append text "\r\r[htmlCloseElem $doctype]\r\r[htmlCloseElem HTML]"
if {![htmlIsEmptyFile]} {deleteText 0 [maxPos]}
insertText $text
goto $currpos
}